home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 1 / Meeting Pearls Vol 1 (1994).iso / amok98-106 / amok105 / textspektor / textspektor.mod < prev    next >
Text File  |  1994-03-28  |  7KB  |  300 lines
  1. (*
  2.  * -------------------------------------------------------------------------
  3.  *
  4.  *    :Program.    TextSpektor
  5.  *    :Contents.    erstellt eine kleine Statistik über Textdateien
  6.  *    :Author.    Reiner Nix
  7.  *    :Address.    Geranienhof 2, 50769 Köln Seeberg
  8.  *    :Address.    rbnix@pool.informatik.rwth-aachen.de
  9.  *    :Copyright.    Public Domain
  10.  *    :Language.    Modula-2
  11.  *    :Translator.    M2Amiga A-L V4.2d
  12.  *    :History.    TextSpektor (2.1 (17.Okt.93)
  13.  *    :Imports.    NewArgSupport, InOut
  14.  *
  15.  * -------------------------------------------------------------------------
  16.  *)
  17.  
  18. MODULE TextSpektor;
  19.  
  20. FROM    SYSTEM            IMPORT    LONGSET,
  21.                     ADR;
  22. FROM    Arts            IMPORT    programName,
  23.                     BreakPoint;
  24. FROM    DosD            IMPORT    ctrlC, noMoreEntries,
  25.                     AnchorPathFlags,
  26.                     AnchorPath;
  27. FROM    DosL            IMPORT    IoErr, Fault,
  28.                     MatchFirst, MatchNext, MatchEnd;
  29. FROM    FileSystem        IMPORT    Response, File,
  30.                     Lookup, Close,
  31.                     ReadBytes;
  32. FROM    String            IMPORT    Compare, Length,
  33.                     Concat, Copy, CopyPart;
  34. FROM    ASCII            IMPORT    ht, eol, ff;
  35. FROM    InOut            IMPORT    Write, WriteString, WriteInt, WriteLn,
  36.                     ReadString;
  37. FROM    NewArgSupport        IMPORT    Str, StrPtr,
  38.                     StrArray, StrArrayPtr,
  39.                     SetArgumentInfo, UseArguments,
  40.                     ArgBoolean, ArgInt, ArgMultiple;
  41.  
  42.  
  43. CONST    Pen1            ="\e[31m";
  44.     Pen2            ="\e[32m";
  45.  
  46.     Version            ="$VER: TextSpektor 2.1 (17.10.93) von Reiner B. Nix";
  47.  
  48.  
  49. VAR    Alles            :BOOLEAN;
  50.     i            :CARDINAL;
  51.     GesamtMaxLaenge,
  52.     GesamtZeilenanzahl,
  53.     GesamtSeitenanzahl,
  54.     Seitenlaenge        :LONGINT;
  55.     Dateinamen        :StrArrayPtr;
  56.  
  57.  
  58.  
  59. PROCEDURE SchreibeFehler    (    Fehler        :LONGINT);
  60.  
  61. CONST    maxFehler        =81;
  62.  
  63. VAR    ok            :BOOLEAN;
  64.       Fehlerkopf,
  65.       Fehlertext        :ARRAY [0..maxFehler] OF CHAR;
  66.  
  67. BEGIN
  68. Copy   (Fehlerkopf, "FEHLER");
  69. ok := Fault (Fehler, ADR (Fehlerkopf), ADR (Fehlertext), maxFehler);
  70. WriteString (Pen2);
  71. IF ok THEN
  72.   WriteString (Fehlertext)
  73. ELSE
  74.   WriteString (Fehlerkopf);
  75.   WriteString (": ???")
  76.   END;
  77. WriteString (Pen1)
  78. END SchreibeFehler;
  79.  
  80.  
  81.  
  82. PROCEDURE UntersucheDatei    (    Dateiname        :ARRAY OF CHAR);
  83.  
  84. CONST    maxBlock        =30*1024;
  85.     TabulatorBreite        =8;
  86.     lesen            =FALSE;
  87.  
  88. VAR    maxLaenge, istLaenge,
  89.     Zeilenanzahl,
  90.     Zeilenposition,
  91.     Seitenanzahl,
  92.     Seitenvorschuebe,
  93.     i, j, k            :LONGINT;
  94.     Datei            :File;
  95.     Block            :ARRAY [0..maxBlock-1] OF CHAR;
  96.     Name            :ARRAY [0..50] OF CHAR;
  97.  
  98.  
  99.  
  100. (* UntersucheDatei *)
  101. BEGIN
  102. WriteString ("  ");
  103. Copy   (Name, Dateiname);
  104. Concat (Name, "                                                  ");
  105. WriteString (Name);
  106.  
  107.  
  108. Lookup (Datei, Dateiname, maxBlock, lesen);
  109. IF Datei.res = done THEN
  110.   maxLaenge        := 0;
  111.   istLaenge        := 0;
  112.   Zeilenanzahl     := 0;
  113.   Zeilenposition   := 0;
  114.   Seitenanzahl     := 0;
  115.   Seitenvorschuebe := 0;
  116.  
  117.   ReadBytes (Datei, ADR (Block), maxBlock, i);
  118.   WHILE (Datei.res = done) & (0 < i) DO
  119.  
  120.     j := 0;
  121.     WHILE j < i DO
  122.       CASE Block[j] OF
  123.       | eol:
  124.         INC (Zeilenanzahl);
  125.  
  126.         IF maxLaenge < istLaenge THEN
  127.           maxLaenge := istLaenge
  128.           END;
  129.         istLaenge := 0
  130.  
  131.       | ff:
  132.         IF Zeilenposition = Zeilenanzahl THEN
  133.           INC (Seitenanzahl)
  134.         ELSE
  135.           INC (Seitenanzahl,
  136.                ((Zeilenanzahl - Zeilenposition) + Seitenlaenge-1) DIV Seitenlaenge);
  137.           Zeilenposition := Zeilenanzahl
  138.           END;
  139.  
  140.         INC (Seitenvorschuebe);
  141.  
  142.         IF maxLaenge < istLaenge THEN
  143.           maxLaenge := istLaenge
  144.           END;
  145.         istLaenge := 0
  146.  
  147.       | ht:
  148.         k := TabulatorBreite - (istLaenge MOD TabulatorBreite);
  149.         IF k = TabulatorBreite THEN
  150.           INC (istLaenge, TabulatorBreite);
  151.         ELSE
  152.           INC (istLaenge, k);
  153.           END
  154.  
  155.       ELSE
  156.         INC (istLaenge)
  157.         END;
  158.  
  159.       INC (j)
  160.       END; (* WHILE j < i *)
  161.  
  162.     ReadBytes (Datei, ADR (Block), maxBlock, i)
  163.     END; (* WHILE Datei.res = done *)
  164.  
  165.  
  166.   IF Datei.res = done THEN
  167.     IF (Zeilenanzahl = 0) AND (0 < istLaenge) THEN
  168.       INC (Zeilenanzahl)
  169.       END;
  170.  
  171.     INC (Seitenanzahl,
  172.          ((Zeilenanzahl - Zeilenposition) + Seitenlaenge-1) DIV Seitenlaenge);
  173.  
  174.     WriteInt (maxLaenge, 4);
  175.     WriteInt (Zeilenanzahl, 8);
  176.     WriteInt (Seitenanzahl, 7);
  177.     WriteInt (Seitenvorschuebe, 10);
  178.  
  179.     IF GesamtMaxLaenge < maxLaenge THEN
  180.       GesamtMaxLaenge := maxLaenge
  181.       END;
  182.     INC (GesamtZeilenanzahl, Zeilenanzahl);
  183.     INC (GesamtSeitenanzahl, Seitenanzahl)
  184.  
  185.   ELSE
  186.     SchreibeFehler (IoErr ())
  187.     END
  188.  
  189. ELSE
  190.   SchreibeFehler (IoErr ())
  191.   END;
  192. Close (Datei);
  193.  
  194. WriteLn
  195. END UntersucheDatei;
  196.  
  197.  
  198.  
  199. PROCEDURE UntersucheAlleDateien    (    Muster        :ARRAY OF CHAR);
  200.  
  201. CONST    maxBuffer        =512;
  202.  
  203. TYPE    Anchor            =RECORD anchorPath    :AnchorPath;
  204.                     anchorName    :ARRAY [0..maxBuffer] OF CHAR
  205.                     END;
  206.  
  207. VAR    matchOk            :LONGINT;
  208.     Anker            :Anchor;
  209.     Name            :ARRAY [0..50] OF CHAR;
  210.  
  211. BEGIN
  212. Anker.anchorPath.strLen := maxBuffer;
  213. Anker.anchorPath.breakBits := LONGSET {ctrlC};
  214.  
  215. matchOk := MatchFirst (ADR (Muster), Anker.anchorPath);
  216. IF matchOk = 0 THEN
  217.     REPEAT
  218.     UntersucheDatei (Anker.anchorName);
  219.     matchOk := MatchNext (Anker.anchorPath)
  220.     UNTIL matchOk # 0
  221. END;
  222. MatchEnd (Anker.anchorPath);
  223.  
  224. IF matchOk # noMoreEntries THEN
  225.   Copy   (Name, Muster);
  226.   Concat (Name, "                                                   ");
  227.   WriteString ("  ");
  228.   WriteString (Name);
  229.  
  230.   SchreibeFehler (matchOk);
  231.   WriteLn
  232.   END
  233. END UntersucheAlleDateien;
  234.  
  235.  
  236. PROCEDURE ProgrammInfo ();
  237.  
  238. VAR    KurzVersion    :ARRAY [0..80] OF CHAR;
  239.  
  240. BEGIN
  241. CopyPart (KurzVersion, Version, 6, Length (Version)-6);
  242.  
  243. WriteLn;
  244. WriteString (Pen2);
  245. WriteString (KurzVersion);
  246. WriteString (Pen1);
  247. WriteLn;
  248.  
  249. WriteString ("  Untersucht Textdateien auf die maximale Zeilenlänge,");       WriteLn;
  250. WriteString ("  die Zeilenanzahl und die Seitenanzahl.");                     WriteLn;
  251. WriteLn;
  252. WriteString ("  Pattern/A/M     Muster für die zu untersuchenden Dateien,");                               WriteLn;
  253. WriteString ("  All/S           Untersuche alle Dateien");                    WriteLn;
  254. WriteString ("                  (noch nicht unterstützt),");                  WriteLn;
  255. WriteString ("  PageLength/K/N  Zeilenanzahl je Seite.");                     WriteLn;
  256. WriteLn
  257. END ProgrammInfo;
  258.  
  259.  
  260. (* MODULE TextSpektor *)
  261. BEGIN
  262. SetArgumentInfo (ProgrammInfo);
  263. UseArguments ("Pattern/A/M,All/S,PageLength/K/N");
  264.  
  265. Dateinamen   := ArgMultiple ("Pattern");
  266. Alles        := ArgBoolean ("All", FALSE);
  267. Seitenlaenge := ArgInt ("PageLength", 70);
  268.  
  269. WriteString (Pen2);
  270. WriteString (StrPtr (programName)^); WriteString (":");
  271. WriteLn;
  272. WriteString ("Seitenlänge = "); WriteInt (Seitenlaenge, 1);
  273. WriteLn;
  274. WriteLn;
  275. WriteString ("  Datei                                       ");
  276. WriteString ("Zeilenlänge -anzahl Seiten Vorschübe");
  277. WriteString (Pen1);
  278. WriteLn;
  279.  
  280. GesamtMaxLaenge    := 0;
  281. GesamtZeilenanzahl := 0;
  282. GesamtSeitenanzahl := 0;
  283.  
  284. IF Dateinamen # NIL THEN
  285.   i := 0;
  286.   WHILE Dateinamen^[i] # NIL DO
  287.     UntersucheAlleDateien (Dateinamen^[i]^);
  288.     INC (i)
  289.     END
  290.   END;
  291.  
  292. WriteLn;
  293. WriteString ("  gesamt                                            ");
  294. WriteInt (GesamtMaxLaenge, 4);
  295. WriteInt (GesamtZeilenanzahl, 8);
  296. WriteInt (GesamtSeitenanzahl, 7);
  297. WriteLn
  298. END TextSpektor.
  299.  
  300.